Option Explicit On
Option Strict Off

'*******************************************************************
' Program: Data Center Visio Rack Tool
' Author: Albert E Edlund
' Date:
'
' Purpose: Some controls intentionally do not have the ability to natively
' do a copy to the clipboard, so these classes allow us to capture screens
' and controls to the clipboard or save as bitmap files
'
' example on how to capture screen to bitmap
'
' Dim clsSS As New ScreenScrape
' clsSS.CaptureScreenToFile("c:\screen.bmp", imageformat.bmp)
'
' example on how to capture a control to clipboard
'
' Dim clsSS As New ScreenScrape
' clsSS.CaptureWindowToClipboard(ctrlName)
' clsSS = Nothing
'
'*********************************************************************




Imports System
Imports System.Text
Imports System.Drawing
Imports System.Drawing.Image
Imports System.Drawing.Bitmap
Imports System.Drawing.Imaging
Imports System.Drawing.Imaging.ImageFormat
Imports System.Runtime.InteropServices

Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling


Friend Class GDI32


    <DllImport("GDI32")> _
    Public Shared Function BitBlt(ByVal handleDeviceContextDest As IntPtr, _
                                  ByVal intXDest As Integer, _
                                  ByVal intYDest As Integer, _
                                  ByVal intWidth As Integer, _
                                  ByVal intHeight As Integer, _
                                  ByVal handleDeviceContextSrc As IntPtr, _
                                  ByVal intXSrc As Integer, _
                                  ByVal intYSrc As Integer, _
                                  ByVal intRop As Integer) _
                                     As Boolean
    End Function

    <DllImport("GDI32")> _
    Public Shared Function CreateCompatibleBitmap(ByVal handleDeviceContext As IntPtr, _
                                                    ByVal intWidth As Integer, _
                                                    ByVal intHeight As Integer) _
                                                        As Integer
    End Function

    <DllImport("GDI32")> _
    Public Shared Function CreateCompatibleDC(ByVal handleDeviceContext As IntPtr) As Integer
    End Function

    <DllImport("GDI32")> _
    Public Shared Function DeleteDC(ByVal handleDeviceContext As IntPtr) As Boolean
    End Function

    <DllImport("GDI32")> _
    Public Shared Function DeleteObject(ByVal intObject As Integer) As Boolean
    End Function

    <DllImport("GDI32")> _
      Public Shared Function GetDeviceCaps(ByVal handleDeviceContext As IntPtr, _
                                ByVal nIndex As Integer) _
                                As Integer
    End Function

    <DllImport("GDI32")> _
      Public Shared Function SelectObject(ByVal handleDeviceContext As IntPtr, _
                            ByVal hgdiobj As Integer) _
                            As Integer
    End Function

End Class


Friend Class User32

    Public Structure LPRECT
        Public left As Integer
        Public top As Integer
        Public right As Integer
        Public bottom As Integer
    End Structure


    <DllImport("User32")> _
    Public Shared Function GetDesktopWindow() _
                                    As IntPtr
    End Function


    <DllImport("User32")> _
    Public Shared Function CreateCompatibleDC(ByVal handleWin As IntPtr) _
                                    As IntPtr
    End Function



    <DllImport("User32")> _
    Public Shared Function GetWindowDC(ByVal handleWin As IntPtr) _
                                    As IntPtr
    End Function

    <DllImport("User32")> _
    Public Shared Function ReleaseDC(ByVal handleWin As IntPtr, _
                                    ByVal handleDC As Integer) _
                                    As IntPtr
    End Function

    ' the clipboard stuff
    <DllImport("User32")> _
    Public Shared Function OpenClipboard(ByVal handleWin As IntPtr) _
                                    As IntPtr
    End Function

    <DllImport("User32")> _
    Public Shared Function EmptyClipboard() _
                                    As IntPtr
    End Function

    <DllImport("User32")> _
    Public Shared Function CloseClipboard() _
                                    As IntPtr
    End Function

    <DllImport("User32")> _
    Public Shared Function SetClipboardData(ByVal intFormat As Integer, _
                                    ByVal handleWin As IntPtr) _
                                    As IntPtr
    End Function

    <DllImport("User32")> _
    Public Shared Function GetWindowRect(ByVal handleWin As IntPtr, _
                                    ByRef lpRect As LPRECT) _
                                    As IntPtr
    End Function

End Class


Public Class ScreenScrape


    ' some controls don't support capturing to clipboard 
    Public Sub CaptureWindowToClipboard _
            (ByVal objControl As System.Windows.Forms.Control)

        Dim sbParameters As New StringBuilder
        Dim intMargin As Integer = 2
        Dim intLeft As Integer = 0
        Dim intTop As Integer = 0
        Dim intRight As Integer = 0
        Dim intBottom As Integer = 0
        Dim rctControl As User32.LPRECT

        Dim intReturn As Integer = Nothing

        Dim handleDesktop As IntPtr = User32.GetDesktopWindow
        Dim handleDCSrc As IntPtr = Nothing
        Dim handleDCDest As IntPtr = Nothing
        Dim handleBitMap As IntPtr = Nothing
        Dim handleControl As IntPtr = Nothing

        Try

            objControl.Focus()
            handleControl = objControl.Handle
            User32.GetWindowRect(handleControl, rctControl)

            With rctControl
                intLeft = .left - intMargin
                intTop = .top - intMargin
                intRight = .right + intMargin
                intBottom = .bottom + intMargin
            End With

            handleDCSrc = User32.GetWindowDC(handleDesktop)
            If handleDCSrc = Nothing Then MsgBox("GetWindowDC Failed")

            handleDCDest = GDI32.CreateCompatibleDC(handleDCSrc)
            If handleDCDest = Nothing Then MsgBox("CreateCompatibleDC Failed")

            ' need handle for source and capabilities (width and height) 
            handleBitMap = GDI32.CreateCompatibleBitmap(handleDCSrc, _
                    intRight - intLeft, _
                    intBottom - intTop)
            If handleBitMap = Nothing Then MsgBox("CreateCompatibleBitmap Failed")

            intReturn = GDI32.SelectObject(handleDCDest, handleBitMap)
            If intReturn = Nothing Then MsgBox("SelectObject Failed")

            intReturn = GDI32.BitBlt(handleDCDest, _
                            0, _
                            0, _
                            intRight - intLeft, _
                            intBottom - intTop, _
                            handleDCSrc, _
                            intLeft, _
                            intTop, _
                            &HCC0020)

            'sbParameters.Append("handleDesktop " & handleDesktop.ToString & vbCrLf)
            'sbParameters.Append("handleDCSrc   " & handleDCSrc.ToString & vbCrLf)
            'sbParameters.Append("handleDCDest  " & handleDCDest.ToString & vbCrLf)
            'sbParameters.Append("handleControl " & handleControl.ToString & vbCrLf)
            'sbParameters.Append("handleBitMap  " & handleBitMap.ToString & vbCrLf)
            'sbParameters.Append("Right         " & intRight.ToString & vbCrLf)
            'sbParameters.Append("Left          " & intLeft.ToString & vbCrLf)
            'sbParameters.Append("Bottom        " & intBottom.ToString & vbCrLf)
            'sbParameters.Append("Top           " & intTop.ToString & vbCrLf)
            'MsgBox(sbParameters.ToString)

            If intReturn = 0 Then MsgBox("BitBlT failed")

            User32.OpenClipboard(handleControl)
            User32.EmptyClipboard()
            User32.SetClipboardData(2&, handleBitMap)
            User32.CloseClipboard()

            ' MSDN promises dire consequences if we do not release what we had
            Cleanup(handleBitMap, _
                    handleDCSrc, _
                    handleDCDest)

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub



    ' in case we want to save the screen as a bitmap
    Public Sub CaptureScreenToFile _
                    (ByVal strFileName As String, _
                    ByVal myFormat As ImageFormat)

        Dim handleDCSrc As Integer
        Dim handleDCDest As Integer
        Dim handleBitMap As Integer

        Try
            handleDCSrc = User32.GetWindowDC(User32.GetDesktopWindow())
            handleDCDest = GDI32.CreateCompatibleDC(handleDCSrc)
            handleBitMap = GDI32.CreateCompatibleBitmap(handleDCSrc, _
                    GDI32.GetDeviceCaps(handleDCSrc, 8), _
                    GDI32.GetDeviceCaps(handleDCSrc, 10))
            GDI32.SelectObject(handleDCDest, handleBitMap)

            GDI32.BitBlt(handleDCDest, _
                            0, _
                            0, _
                            GDI32.GetDeviceCaps(handleDCSrc, 8), _
                            GDI32.GetDeviceCaps(handleDCSrc, 10), _
                            handleDCSrc, _
                            0, _
                            0, _
                            &HCC0020)


            ' save the screen image
            SaveImageAs(handleBitMap, _
                    strFileName, _
                    myFormat)

            ' again release what we had
            Cleanup(handleBitMap, _
                    handleDCSrc, _
                    handleDCDest)

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub




    Private Sub SaveImageAs(ByVal handleBitMap As Integer, _
                          ByVal strFileName As String, _
                          ByVal myFormat As System.Drawing.Imaging.ImageFormat)
        Try
            Dim BitMap As Image = New Bitmap(Image.FromHbitmap(New IntPtr(handleBitMap)), _
                        Image.FromHbitmap(New IntPtr(handleBitMap)).Width, _
                        Image.FromHbitmap(New IntPtr(handleBitMap)).Height)

            BitMap.Save(strFileName, myFormat)

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub

    Private Sub Cleanup(ByVal handleBitMap As Integer, _
                        ByVal handleDeviceContextSrc As Integer, _
                        ByVal handleDeviceContextDest As Integer)

        User32.ReleaseDC(User32.GetDesktopWindow(), handleDeviceContextSrc)
        GDI32.DeleteDC(handleDeviceContextDest)
        GDI32.DeleteObject(handleBitMap)

    End Sub

End Class